home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994…tember: Reference Library / Dev.CD Sep 94.toast / Periodicals / develop / develop Issue 11 / develop 11 code / The NetWork Project / Examples (Sources) / NetSim / HistogramIo.inc < prev    next >
Encoding:
Text File  |  1992-07-15  |  3.2 KB  |  137 lines  |  [TEXT/MPS ]
  1. { HistogramIo.inc     © Copyright G. Sawitzki, 1988-1991}
  2. {$S Histogram}
  3. const         cTextSize=9;
  4.     chunk=4;
  5. type         tHistTable=array[0..maxclass] of extended;  
  6.  
  7. procedure PrepareHistHist(var xhist,yhist: histtype;var comprect:rect;contents:str15);
  8. const boundary=5;
  9. var
  10.     temprect:rect;
  11.     s:str255;
  12. begin
  13.     temprect:=comprect; 
  14.     insetrect(temprect,-1,-1);framerect(temprect);
  15.     eraserect(comprect);textsize(9);
  16.     penNormal;
  17.     with comprect do
  18.     begin
  19.         moveto(left,bottom);lineto(right,top);
  20.         moveto(left+boundary,top+ctextsize+boundary);
  21.         drawstring(concat(contents,' ',yhist.id));
  22.  
  23.         s:=concat(contents,' ',xhist.id);
  24.         moveto(right-boundary-stringwidth(s),bottom-boundary);
  25.         drawstring(s);
  26.     end;
  27. end;
  28.  
  29. procedure HistToTable(var hist:histtype; var DataPoint, DistrFunction:tHistTable);
  30. var i:integer;
  31. begin
  32.     with hist do begin
  33.         DistrFunction[0]:=cnt[0]/count;DataPoint[0]:=min+binwidth;
  34.         for i:=1 to maxclass do 
  35.         begin
  36.             DistrFunction[i]:=DistrFunction[i-1]+cnt[i]/count;
  37.             DataPoint[i]:=min+(i+1)*binwidth;
  38.         end;    
  39.     end;
  40. end;
  41.  
  42.  
  43. procedure showHistogram (var histogram: histtype; var histrect: rect;NumbForm: DecForm);
  44. const boundary=5;
  45. var
  46.     i: longint;
  47.     myhdle: pichandle;
  48.     hilfreal, myfakty, myfaktx: extended;
  49.     horsize, vertsize, xoffs, yoffs: integer;
  50.     dstr: decstr;
  51.     penwidth: integer;
  52.     temprect:rect;
  53. begin
  54.     pennormal;
  55.     temprect:=histrect; 
  56.     insetrect(temprect,-1,-1);framerect(temprect);
  57.     eraserect(histrect);textsize(cTextSize);
  58.  
  59.     with histogram, histrect do
  60.     begin
  61.         horsize := right - left;
  62.         vertsize := bottom - top -cTextSize-3 * boundary;
  63.  
  64.         moveto(left + 2, bottom - 2);
  65.         num2str(numbform, min, dstr);
  66.         drawstring(dstr);
  67.         num2str(numbform, max, dstr);
  68.         moveto(right - 2 - stringwidth(dstr), bottom - 2);
  69.         drawstring(dstr);
  70.         moveto(left + (right - left - stringwidth(id)) div 2, bottom - 2);
  71.         drawstring(id);
  72.  
  73.         penwidth := (horsize - 2) div (2 * maxclass + 1);
  74.         if penwidth=0 then penwidth:=1;
  75.         pensize(penwidth, penwidth);
  76.  
  77.         myfakty := vertsize / histogram.maxbincount;{••••}
  78.         myfaktx := horsize / (maxclass + 1);
  79.         with histrect do
  80.         begin
  81.             xoffs := left;
  82.             yoffs := bottom - 2*boundary-cTextSize;
  83.         end;
  84.  
  85.         for i := 0 to maxclass do
  86.         if cnt[i] > 0 then
  87.         begin
  88.             hilfreal := myfakty * histogram.cnt[i];
  89.             moveto(xoffs + i * round(myfaktx), yoffs);{•••}
  90.             lineto(xoffs + i * round(myfaktx), yoffs - round(hilfreal));{•••}
  91.         end;
  92.         pennormal;
  93.         moveto(xoffs, yoffs + penwidth);
  94.         lineto(right, yoffs + penwidth);
  95.     end;{with histogram}
  96.     {framerect(histrect);}
  97. end;
  98.  
  99.  
  100. procedure ReportStat (var stat: tStatType; var r: rect; var form: DecForm);
  101. const
  102.     xmargin = 2;
  103.     ydelta = 12;
  104. var
  105.     dstr: decstr;
  106.     temp: extended;
  107.     s:str255;
  108. begin
  109.     with stat, r do
  110.     begin
  111.         eraseRect(r);textsize(9);
  112.         moveto(left + xmargin, top + ydelta);
  113.         num2str(form, min, dstr);
  114.         drawstring(dstr);
  115.  
  116.         num2str(form, max, dstr);
  117.         moveto(right - xmargin - stringwidth(dstr), top + ydelta);
  118.         drawstring(dstr);
  119.         moveto(left + (right - left - stringwidth(id)) div 2, top + ydelta);
  120.         drawstring(id);
  121.  
  122.         moveto(left + xmargin, top + 2 * ydelta);
  123.         drawstring('µ: ');
  124.         num2str(form, mean, dstr);
  125.         drawstring(dstr);
  126.         if count > 1 then
  127.         begin
  128.             temp := sqrt(ssq / (count - 1));
  129.             Num2Str(form, temp, dstr);
  130.             drawstring(concat('  (', dstr, ')'));
  131.         end;
  132.         NumToString(count,s);
  133.         drawstring(concat(' n=',s));
  134.     end;
  135. end;
  136.  
  137.